home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1998 May / Macworld (1998-05).dmg / Serious Demos / TeamWave 3.0 / TeamWave Workplace / TeamWave Workplace.rsrc / TEXT_4_entry.txt < prev    next >
Text File  |  1998-02-13  |  15KB  |  608 lines
  1. # entry.tcl --
  2. #
  3. # This file defines the default bindings for Tk entry widgets and provides
  4. # procedures that help in implementing those bindings.
  5. #
  6. # SCCS: @(#) entry.tcl 1.49 97/09/17 19:08:48
  7. #
  8. # Copyright (c) 1992-1994 The Regents of the University of California.
  9. # Copyright (c) 1994-1997 Sun Microsystems, Inc.
  10. #
  11. # See the file "license.terms" for information on usage and redistribution
  12. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  13. #
  14.  
  15. #-------------------------------------------------------------------------
  16. # Elements of tkPriv that are used in this file:
  17. #
  18. # afterId -        If non-null, it means that auto-scanning is underway
  19. #            and it gives the "after" id for the next auto-scan
  20. #            command to be executed.
  21. # mouseMoved -        Non-zero means the mouse has moved a significant
  22. #            amount since the button went down (so, for example,
  23. #            start dragging out a selection).
  24. # pressX -        X-coordinate at which the mouse button was pressed.
  25. # selectMode -        The style of selection currently underway:
  26. #            char, word, or line.
  27. # x, y -        Last known mouse coordinates for scanning
  28. #            and auto-scanning.
  29. #-------------------------------------------------------------------------
  30.  
  31. #-------------------------------------------------------------------------
  32. # The code below creates the default class bindings for entries.
  33. #-------------------------------------------------------------------------
  34.  
  35. bind Entry <<Cut>> {
  36.     if {![catch {set data [string range [%W get] [%W index sel.first]\
  37.          [expr [%W index sel.last] - 1]]}]} {
  38.     clipboard clear -displayof %W
  39.     clipboard append -displayof %W $data
  40.     %W delete sel.first sel.last
  41.     }
  42. }
  43. bind Entry <<Copy>> {
  44.     if {![catch {set data [string range [%W get] [%W index sel.first]\
  45.          [expr [%W index sel.last] - 1]]}]} {
  46.     clipboard clear -displayof %W
  47.     clipboard append -displayof %W $data
  48.     }
  49. }
  50. bind Entry <<Paste>> {
  51.     global tcl_platform
  52.     catch {
  53.     if {"$tcl_platform(platform)" != "unix"} {
  54.         catch {
  55.         %W delete sel.first sel.last
  56.         }
  57.     }
  58.     %W insert insert [selection get -displayof %W -selection CLIPBOARD]
  59.     tkEntrySeeInsert %W
  60.     }
  61. }
  62. bind Entry <<Clear>> {
  63.     %W delete sel.first sel.last
  64. }
  65.  
  66. # Standard Motif bindings:
  67.  
  68. bind Entry <1> {
  69.     tkEntryButton1 %W %x
  70.     %W selection clear
  71. }
  72. bind Entry <B1-Motion> {
  73.     set tkPriv(x) %x
  74.     tkEntryMouseSelect %W %x
  75. }
  76. bind Entry <Double-1> {
  77.     set tkPriv(selectMode) word
  78.     tkEntryMouseSelect %W %x
  79.     catch {%W icursor sel.first}
  80. }
  81. bind Entry <Triple-1> {
  82.     set tkPriv(selectMode) line
  83.     tkEntryMouseSelect %W %x
  84.     %W icursor 0
  85. }
  86. bind Entry <Shift-1> {
  87.     set tkPriv(selectMode) char
  88.     %W selection adjust @%x
  89. }
  90. bind Entry <Double-Shift-1>    {
  91.     set tkPriv(selectMode) word
  92.     tkEntryMouseSelect %W %x
  93. }
  94. bind Entry <Triple-Shift-1>    {
  95.     set tkPriv(selectMode) line
  96.     tkEntryMouseSelect %W %x
  97. }
  98. bind Entry <B1-Leave> {
  99.     set tkPriv(x) %x
  100.     tkEntryAutoScan %W
  101. }
  102. bind Entry <B1-Enter> {
  103.     tkCancelRepeat
  104. }
  105. bind Entry <ButtonRelease-1> {
  106.     tkCancelRepeat
  107. }
  108. bind Entry <Control-1> {
  109.     %W icursor @%x
  110. }
  111. bind Entry <ButtonRelease-2> {
  112.     if {!$tkPriv(mouseMoved) || $tk_strictMotif} {
  113.     tkEntryPaste %W %x
  114.     }
  115. }
  116.  
  117. bind Entry <Left> {
  118.     tkEntrySetCursor %W [expr [%W index insert] - 1]
  119. }
  120. bind Entry <Right> {
  121.     tkEntrySetCursor %W [expr [%W index insert] + 1]
  122. }
  123. bind Entry <Shift-Left> {
  124.     tkEntryKeySelect %W [expr [%W index insert] - 1]
  125.     tkEntrySeeInsert %W
  126. }
  127. bind Entry <Shift-Right> {
  128.     tkEntryKeySelect %W [expr [%W index insert] + 1]
  129.     tkEntrySeeInsert %W
  130. }
  131. bind Entry <Control-Left> {
  132.     tkEntrySetCursor %W [tkEntryPreviousWord %W insert]
  133. }
  134. bind Entry <Control-Right> {
  135.     tkEntrySetCursor %W [tkEntryNextWord %W insert]
  136. }
  137. bind Entry <Shift-Control-Left> {
  138.     tkEntryKeySelect %W [tkEntryPreviousWord %W insert]
  139.     tkEntrySeeInsert %W
  140. }
  141. bind Entry <Shift-Control-Right> {
  142.     tkEntryKeySelect %W [tkEntryNextWord %W insert]
  143.     tkEntrySeeInsert %W
  144. }
  145. bind Entry <Home> {
  146.     tkEntrySetCursor %W 0
  147. }
  148. bind Entry <Shift-Home> {
  149.     tkEntryKeySelect %W 0
  150.     tkEntrySeeInsert %W
  151. }
  152. bind Entry <End> {
  153.     tkEntrySetCursor %W end
  154. }
  155. bind Entry <Shift-End> {
  156.     tkEntryKeySelect %W end
  157.     tkEntrySeeInsert %W
  158. }
  159.  
  160. bind Entry <Delete> {
  161.     if [%W selection present] {
  162.     %W delete sel.first sel.last
  163.     } else {
  164.     %W delete insert
  165.     }
  166. }
  167. bind Entry <BackSpace> {
  168.     tkEntryBackspace %W
  169. }
  170.  
  171. bind Entry <Control-space> {
  172.     %W selection from insert
  173. }
  174. bind Entry <Select> {
  175.     %W selection from insert
  176. }
  177. bind Entry <Control-Shift-space> {
  178.     %W selection adjust insert
  179. }
  180. bind Entry <Shift-Select> {
  181.     %W selection adjust insert
  182. }
  183. bind Entry <Control-slash> {
  184.     %W selection range 0 end
  185. }
  186. bind Entry <Control-backslash> {
  187.     %W selection clear
  188. }
  189. bind Entry <KeyPress> {
  190.     tkEntryInsert %W %A
  191. }
  192.  
  193. # Ignore all Alt, Meta, and Control keypresses unless explicitly bound.
  194. # Otherwise, if a widget binding for one of these is defined, the
  195. # <KeyPress> class binding will also fire and insert the character,
  196. # which is wrong.  Ditto for Escape, Return, and Tab.
  197.  
  198. bind Entry <Alt-KeyPress> {# nothing}
  199. bind Entry <Meta-KeyPress> {# nothing}
  200. bind Entry <Control-KeyPress> {# nothing}
  201. bind Entry <Escape> {# nothing}
  202. bind Entry <Return> {# nothing}
  203. bind Entry <KP_Enter> {# nothing}
  204. bind Entry <Tab> {# nothing}
  205. if {$tcl_platform(platform) == "macintosh"} {
  206.     bind Entry <Command-KeyPress> {# nothing}
  207. }
  208.  
  209. bind Entry <Insert> {
  210.     catch {tkEntryInsert %W [selection get -displayof %W]}
  211. }
  212.  
  213. # Additional emacs-like bindings:
  214.  
  215. bind Entry <Control-a> {
  216.     if !$tk_strictMotif {
  217.     tkEntrySetCursor %W 0
  218.     }
  219. }
  220. bind Entry <Control-b> {
  221.     if !$tk_strictMotif {
  222.     tkEntrySetCursor %W [expr [%W index insert] - 1]
  223.     }
  224. }
  225. bind Entry <Control-d> {
  226.     if !$tk_strictMotif {
  227.     %W delete insert
  228.     }
  229. }
  230. bind Entry <Control-e> {
  231.     if !$tk_strictMotif {
  232.     tkEntrySetCursor %W end
  233.     }
  234. }
  235. bind Entry <Control-f> {
  236.     if !$tk_strictMotif {
  237.     tkEntrySetCursor %W [expr [%W index insert] + 1]
  238.     }
  239. }
  240. bind Entry <Control-h> {
  241.     if !$tk_strictMotif {
  242.     tkEntryBackspace %W
  243.     }
  244. }
  245. bind Entry <Control-k> {
  246.     if !$tk_strictMotif {
  247.     %W delete insert end
  248.     }
  249. }
  250. bind Entry <Control-t> {
  251.     if !$tk_strictMotif {
  252.     tkEntryTranspose %W
  253.     }
  254. }
  255. bind Entry <Meta-b> {
  256.     if !$tk_strictMotif {
  257.     tkEntrySetCursor %W [tkEntryPreviousWord %W insert]
  258.     }
  259. }
  260. bind Entry <Meta-d> {
  261.     if !$tk_strictMotif {
  262.     %W delete insert [tkEntryNextWord %W insert]
  263.     }
  264. }
  265. bind Entry <Meta-f> {
  266.     if !$tk_strictMotif {
  267.     tkEntrySetCursor %W [tkEntryNextWord %W insert]
  268.     }
  269. }
  270. bind Entry <Meta-BackSpace> {
  271.     if !$tk_strictMotif {
  272.     %W delete [tkEntryPreviousWord %W insert] insert
  273.     }
  274. }
  275. bind Entry <Meta-Delete> {
  276.     if !$tk_strictMotif {
  277.     %W delete [tkEntryPreviousWord %W insert] insert
  278.     }
  279. }
  280.  
  281. # A few additional bindings of my own.
  282.  
  283. bind Entry <2> {
  284.     if !$tk_strictMotif {
  285.     %W scan mark %x
  286.     set tkPriv(x) %x
  287.     set tkPriv(y) %y
  288.     set tkPriv(mouseMoved) 0
  289.     }
  290. }
  291. bind Entry <B2-Motion> {
  292.     if !$tk_strictMotif {
  293.     if {abs(%x-$tkPriv(x)) > 2} {
  294.         set tkPriv(mouseMoved) 1
  295.     }
  296.     %W scan dragto %x
  297.     }
  298. }
  299.  
  300. # tkEntryClosestGap --
  301. # Given x and y coordinates, this procedure finds the closest boundary
  302. # between characters to the given coordinates and returns the index
  303. # of the character just after the boundary.
  304. #
  305. # Arguments:
  306. # w -        The entry window.
  307. # x -        X-coordinate within the window.
  308.  
  309. proc tkEntryClosestGap {w x} {
  310.     set pos [$w index @$x]
  311.     set bbox [$w bbox $pos]
  312.     if {($x - [lindex $bbox 0]) < ([lindex $bbox 2]/2)} {
  313.     return $pos
  314.     }
  315.     incr pos
  316. }
  317.  
  318. # tkEntryButton1 --
  319. # This procedure is invoked to handle button-1 presses in entry
  320. # widgets.  It moves the insertion cursor, sets the selection anchor,
  321. # and claims the input focus.
  322. #
  323. # Arguments:
  324. # w -        The entry window in which the button was pressed.
  325. # x -        The x-coordinate of the button press.
  326.  
  327. proc tkEntryButton1 {w x} {
  328.     global tkPriv
  329.  
  330.     set tkPriv(selectMode) char
  331.     set tkPriv(mouseMoved) 0
  332.     set tkPriv(pressX) $x
  333.     $w icursor [tkEntryClosestGap $w $x]
  334.     $w selection from insert
  335.     if {[lindex [$w configure -state] 4] == "normal"} {focus $w}
  336. }
  337.  
  338. # tkEntryMouseSelect --
  339. # This procedure is invoked when dragging out a selection with
  340. # the mouse.  Depending on the selection mode (character, word,
  341. # line) it selects in different-sized units.  This procedure
  342. # ignores mouse motions initially until the mouse has moved from
  343. # one character to another or until there have been multiple clicks.
  344. #
  345. # Arguments:
  346. # w -        The entry window in which the button was pressed.
  347. # x -        The x-coordinate of the mouse.
  348.  
  349. proc tkEntryMouseSelect {w x} {
  350.     global tkPriv
  351.  
  352.     set cur [tkEntryClosestGap $w $x]
  353.     set anchor [$w index anchor]
  354.     if {($cur != $anchor) || (abs($tkPriv(pressX) - $x) >= 3)} {
  355.     set tkPriv(mouseMoved) 1
  356.     }
  357.     switch $tkPriv(selectMode) {
  358.     char {
  359.         if $tkPriv(mouseMoved) {
  360.         if {$cur < $anchor} {
  361.             $w selection range $cur $anchor
  362.         } elseif {$cur > $anchor} {
  363.             $w selection range $anchor $cur
  364.         } else {
  365.             $w selection clear
  366.         }
  367.         }
  368.     }
  369.     word {
  370.         if {$cur < [$w index anchor]} {
  371.         set before [tcl_wordBreakBefore [$w get] $cur]
  372.         set after [tcl_wordBreakAfter [$w get] [expr $anchor-1]]
  373.         } else {
  374.         set before [tcl_wordBreakBefore [$w get] $anchor]
  375.         set after [tcl_wordBreakAfter [$w get] [expr $cur - 1]]
  376.         }
  377.         if {$before < 0} {
  378.         set before 0
  379.         }
  380.         if {$after < 0} {
  381.         set after end
  382.         }
  383.         $w selection range $before $after
  384.     }
  385.     line {
  386.         $w selection range 0 end
  387.     }
  388.     }
  389.     update idletasks
  390. }
  391.  
  392. # tkEntryPaste --
  393. # This procedure sets the insertion cursor to the current mouse position,
  394. # pastes the selection there, and sets the focus to the window.
  395. #
  396. # Arguments:
  397. # w -        The entry window.
  398. # x -        X position of the mouse.
  399.  
  400. proc tkEntryPaste {w x} {
  401.     global tkPriv
  402.  
  403.     $w icursor [tkEntryClosestGap $w $x]
  404.     catch {$w insert insert [selection get -displayof $w]}
  405.     if {[lindex [$w configure -state] 4] == "normal"} {focus $w}
  406. }
  407.  
  408. # tkEntryAutoScan --
  409. # This procedure is invoked when the mouse leaves an entry window
  410. # with button 1 down.  It scrolls the window left or right,
  411. # depending on where the mouse is, and reschedules itself as an
  412. # "after" command so that the window continues to scroll until the
  413. # mouse moves back into the window or the mouse button is released.
  414. #
  415. # Arguments:
  416. # w -        The entry window.
  417.  
  418. proc tkEntryAutoScan {w} {
  419.     global tkPriv
  420.     set x $tkPriv(x)
  421.     if {![winfo exists $w]} return
  422.     if {$x >= [winfo width $w]} {
  423.     $w xview scroll 2 units
  424.     tkEntryMouseSelect $w $x
  425.     } elseif {$x < 0} {
  426.     $w xview scroll -2 units
  427.     tkEntryMouseSelect $w $x
  428.     }
  429.     set tkPriv(afterId) [after 50 tkEntryAutoScan $w]
  430. }
  431.  
  432. # tkEntryKeySelect --
  433. # This procedure is invoked when stroking out selections using the
  434. # keyboard.  It moves the cursor to a new position, then extends
  435. # the selection to that position.
  436. #
  437. # Arguments:
  438. # w -        The entry window.
  439. # new -        A new position for the insertion cursor (the cursor hasn't
  440. #        actually been moved to this position yet).
  441.  
  442. proc tkEntryKeySelect {w new} {
  443.     if ![$w selection present] {
  444.     $w selection from insert
  445.     $w selection to $new
  446.     } else {
  447.     $w selection adjust $new
  448.     }
  449.     $w icursor $new
  450. }
  451.  
  452. # tkEntryInsert --
  453. # Insert a string into an entry at the point of the insertion cursor.
  454. # If there is a selection in the entry, and it covers the point of the
  455. # insertion cursor, then delete the selection before inserting.
  456. #
  457. # Arguments:
  458. # w -        The entry window in which to insert the string
  459. # s -        The string to insert (usually just a single character)
  460.  
  461. proc tkEntryInsert {w s} {
  462.     if {$s == ""} {
  463.     return
  464.     }
  465.     catch {
  466.     set insert [$w index insert]
  467.     if {([$w index sel.first] <= $insert)
  468.         && ([$w index sel.last] >= $insert)} {
  469.         $w delete sel.first sel.last
  470.     }
  471.     }
  472.     $w insert insert $s
  473.     tkEntrySeeInsert $w
  474. }
  475.  
  476. # tkEntryBackspace --
  477. # Backspace over the character just before the insertion cursor.
  478. # If backspacing would move the cursor off the left edge of the
  479. # window, reposition the cursor at about the middle of the window.
  480. #
  481. # Arguments:
  482. # w -        The entry window in which to backspace.
  483.  
  484. proc tkEntryBackspace w {
  485.     if [$w selection present] {
  486.     $w delete sel.first sel.last
  487.     } else {
  488.     set x [expr {[$w index insert] - 1}]
  489.     if {$x >= 0} {$w delete $x}
  490.     if {[$w index @0] >= [$w index insert]} {
  491.         set range [$w xview]
  492.         set left [lindex $range 0]
  493.         set right [lindex $range 1]
  494.         $w xview moveto [expr $left - ($right - $left)/2.0]
  495.     }
  496.     }
  497. }
  498.  
  499. # tkEntrySeeInsert --
  500. # Make sure that the insertion cursor is visible in the entry window.
  501. # If not, adjust the view so that it is.
  502. #
  503. # Arguments:
  504. # w -        The entry window.
  505.  
  506. proc tkEntrySeeInsert w {
  507.     set c [$w index insert]
  508.     set left [$w index @0]
  509.     if {$left > $c} {
  510.     $w xview $c
  511.     return
  512.     }
  513.     set x [winfo width $w]
  514.     while {([$w index @$x] <= $c) && ($left < $c)} {
  515.     incr left
  516.     $w xview $left
  517.     }
  518. }
  519.  
  520. # tkEntrySetCursor -
  521. # Move the insertion cursor to a given position in an entry.  Also
  522. # clears the selection, if there is one in the entry, and makes sure
  523. # that the insertion cursor is visible.
  524. #
  525. # Arguments:
  526. # w -        The entry window.
  527. # pos -        The desired new position for the cursor in the window.
  528.  
  529. proc tkEntrySetCursor {w pos} {
  530.     $w icursor $pos
  531.     $w selection clear
  532.     tkEntrySeeInsert $w
  533. }
  534.  
  535. # tkEntryTranspose -
  536. # This procedure implements the "transpose" function for entry widgets.
  537. # It tranposes the characters on either side of the insertion cursor,
  538. # unless the cursor is at the end of the line.  In this case it
  539. # transposes the two characters to the left of the cursor.  In either
  540. # case, the cursor ends up to the right of the transposed characters.
  541. #
  542. # Arguments:
  543. # w -        The entry window.
  544.  
  545. proc tkEntryTranspose w {
  546.     set i [$w index insert]
  547.     if {$i < [$w index end]} {
  548.     incr i
  549.     }
  550.     set first [expr $i-2]
  551.     if {$first < 0} {
  552.     return
  553.     }
  554.     set new [string index [$w get] [expr $i-1]][string index [$w get] $first]
  555.     $w delete $first $i
  556.     $w insert insert $new
  557.     tkEntrySeeInsert $w
  558. }
  559.  
  560. # tkEntryNextWord --
  561. # Returns the index of the next word position after a given position in the
  562. # entry.  The next word is platform dependent and may be either the next
  563. # end-of-word position or the next start-of-word position after the next
  564. # end-of-word position.
  565. #
  566. # Arguments:
  567. # w -        The entry window in which the cursor is to move.
  568. # start -    Position at which to start search.
  569.  
  570. if {$tcl_platform(platform) == "windows"}  {
  571.     proc tkEntryNextWord {w start} {
  572.     set pos [tcl_endOfWord [$w get] [$w index $start]]
  573.     if {$pos >= 0} {
  574.         set pos [tcl_startOfNextWord [$w get] $pos]
  575.     }
  576.     if {$pos < 0} {
  577.         return end
  578.     }
  579.     return $pos
  580.     }
  581. } else {
  582.     proc tkEntryNextWord {w start} {
  583.     set pos [tcl_endOfWord [$w get] [$w index $start]]
  584.     if {$pos < 0} {
  585.         return end
  586.     }
  587.     return $pos
  588.     }
  589. }
  590.  
  591. # tkEntryPreviousWord --
  592. #
  593. # Returns the index of the previous word position before a given
  594. # position in the entry.
  595. #
  596. # Arguments:
  597. # w -        The entry window in which the cursor is to move.
  598. # start -    Position at which to start search.
  599.  
  600. proc tkEntryPreviousWord {w start} {
  601.     set pos [tcl_startOfPreviousWord [$w get] [$w index $start]]
  602.     if {$pos < 0} {
  603.     return 0
  604.     }
  605.     return $pos
  606. }
  607.  
  608.